home *** CD-ROM | disk | FTP | other *** search
/ Kit PC World De Ampliacion De Windows 95 / Kit PC World de ampliacion de Windows 95.iso / clarion / cw15 / examp15.z / DOMIN.CLW < prev    next >
Encoding:
Text File  |  1995-09-05  |  21.6 KB  |  724 lines
  1. ! DOMIN: A simple windows game
  2. ! ============================
  3.  
  4. ! NB This program is not written with style in mind, as it is
  5. ! only intended as a demonstration OF some OF the capabilities
  6. ! OF the CW system
  7.  
  8.  
  9.   PROGRAM
  10.   INCLUDE('EQUATES.CLW')
  11.   INCLUDE('KEYCODES.CLW')
  12.   MAP
  13.     showp(BYTE,BYTE)
  14.     init()
  15.     asknewgame(),BYTE
  16.     gameover()
  17.     setsize()
  18.     setcursors()
  19.     getoptions()
  20.     addc(BYTE,BYTE,BYTE)
  21.     capacity(BYTE,BYTE),BYTE
  22.     canadd(BYTE,BYTE,BYTE),BYTE
  23.     positional(*BYTE,*BYTE,BYTE)
  24.     locate_target(BYTE),BYTE
  25.     aboutbox()
  26.   END
  27.  
  28.  
  29. maxwidth   EQUATE (12)
  30.  
  31. boardwidth STRING(10),AUTO
  32. width      SHORT,AUTO
  33. t          BYTE,DIM(maxwidth),dim(maxwidth),AUTO
  34. xp         BYTE,AUTO
  35. yp         BYTE,AUTO
  36. gameinprogress BYTE
  37. nplaying   BYTE
  38. nextgo     BYTE
  39. mplayers   EQUATE(4)
  40. wp         BYTE,DIM(mplayers),AUTO
  41. scores     LONG,DIM(mplayers),AUTO
  42. playname   STRING(12),DIM(mplayers),AUTO
  43. counts     USHORT,DIM(4),AUTO
  44.  
  45. SHuman     EQUATE(1)
  46. SDefence   EQUATE(2)
  47. SHomicidal EQUATE(3)
  48. SRegicidal EQUATE(4)
  49. SDrifter   EQUATE(5)
  50.  
  51. scr  WINDOW('Domination'),AT(,,120,120),CENTER,ICON('WINPYR.ICO'),HLP('~Domination'),STATUS,SYSTEM
  52.        MENUBAR
  53.          MENU('&File'),MSG('File menu')
  54.            ITEM('E&xit'),USE(?exit,5000),MSG('End this game')
  55.          END
  56.          MENU('&Game'),MSG('Game menu')
  57.            ITEM('&New<9>F2'),USE(?new),MSG('Start a new game'),KEY(F2Key)
  58.            ITEM('&Options...'),USE(?options),HLP('~Options'),MSG('Select players ...')
  59.          END
  60.          MENU('&Help'),MSG('Help menu')
  61.            ITEM('&Contents'),USE(?helpcontents),MSG('Start a new game'),KEY(F2Key)
  62.            ITEM,SEPARATOR
  63.            ITEM('&About...'),USE(?about),MSG('About Domination')
  64.          END
  65.        END
  66.        BUTTON,AT(30,10,10,10),KEY(Alt0),USE(?but11,1)
  67.        BUTTON,AT(40,10,10,10),USE(?but12)
  68.        BUTTON,AT(50,10,10,10),USE(?but13)
  69.        BUTTON,AT(60,10,10,10),USE(?but14)
  70.        BUTTON,AT(70,10,10,10),USE(?but15)
  71.        BUTTON,AT(80,10,10,10),USE(?but16)
  72.        BUTTON,AT(90,10,10,10),USE(?but17)
  73.        BUTTON,AT(100,10,10,10),USE(?but18)
  74.        BUTTON,AT(110,10,10,10),USE(?but19)
  75.        BUTTON,AT(120,10,10,10),USE(?but1a)
  76.        BUTTON,AT(130,10,10,10),USE(?but1b)
  77.        BUTTON,AT(140,10,10,10),USE(?but1c)
  78.        BUTTON,AT(30,20,10,10),USE(?but21)
  79.        BUTTON,AT(40,20,10,10),USE(?but22)
  80.        BUTTON,AT(50,20,10,10),USE(?but23)
  81.        BUTTON,AT(60,20,10,10),USE(?but24)
  82.        BUTTON,AT(70,20,10,10),USE(?but25)
  83.        BUTTON,AT(80,20,10,10),USE(?but26)
  84.        BUTTON,AT(90,20,10,10),USE(?but27)
  85.        BUTTON,AT(100,20,10,10),USE(?but28)
  86.        BUTTON,AT(110,20,10,10),USE(?but29)
  87.        BUTTON,AT(120,20,10,10),USE(?but2a)
  88.        BUTTON,AT(130,20,10,10),USE(?but2b)
  89.        BUTTON,AT(140,20,10,10),USE(?but2c)
  90.        BUTTON,AT(30,30,10,10),USE(?but31)
  91.        BUTTON,AT(40,30,10,10),USE(?but32)
  92.        BUTTON,AT(50,30,10,10),USE(?but33)
  93.        BUTTON,AT(60,30,10,10),USE(?but34)
  94.        BUTTON,AT(70,30,10,10),USE(?but35)
  95.        BUTTON,AT(80,30,10,10),USE(?but36)
  96.        BUTTON,AT(90,30,10,10),USE(?but37)
  97.        BUTTON,AT(100,30,10,10),USE(?but38)
  98.        BUTTON,AT(110,30,10,10),USE(?but39)
  99.        BUTTON,AT(120,30,10,10),USE(?but3a)
  100.        BUTTON,AT(130,30,10,10),USE(?but3b)
  101.        BUTTON,AT(140,30,10,10),USE(?but3c)
  102.        BUTTON,AT(30,40,10,10),USE(?but41)
  103.        BUTTON,AT(40,40,10,10),USE(?but42)
  104.        BUTTON,AT(50,40,10,10),USE(?but43)
  105.        BUTTON,AT(60,40,10,10),USE(?but44)
  106.        BUTTON,AT(70,40,10,10),USE(?but45)
  107.        BUTTON,AT(80,40,10,10),USE(?but46)
  108.        BUTTON,AT(90,40,10,10),USE(?but47)
  109.        BUTTON,AT(100,40,10,10),USE(?but48)
  110.        BUTTON,AT(110,40,10,10),USE(?but49)
  111.        BUTTON,AT(120,40,10,10),USE(?but4a)
  112.        BUTTON,AT(130,40,10,10),USE(?but4b)
  113.        BUTTON,AT(140,40,10,10),USE(?but4c)
  114.        BUTTON,AT(30,50,10,10),USE(?but51)
  115.        BUTTON,AT(40,50,10,10),USE(?but52)
  116.        BUTTON,AT(50,50,10,10),USE(?but53)
  117.        BUTTON,AT(60,50,10,10),USE(?but54)
  118.        BUTTON,AT(70,50,10,10),USE(?but55)
  119.        BUTTON,AT(80,50,10,10),USE(?but56)
  120.        BUTTON,AT(90,50,10,10),USE(?but57)
  121.        BUTTON,AT(100,50,10,10),USE(?but58)
  122.        BUTTON,AT(110,50,10,10),USE(?but59)
  123.        BUTTON,AT(120,50,10,10),USE(?but5a)
  124.        BUTTON,AT(130,50,10,10),USE(?but5b)
  125.        BUTTON,AT(140,50,10,10),USE(?but5c)
  126.        BUTTON,AT(30,60,10,10),USE(?but61)
  127.        BUTTON,AT(40,60,10,10),USE(?but62)
  128.        BUTTON,AT(50,60,10,10),USE(?but63)
  129.        BUTTON,AT(60,60,10,10),USE(?but64)
  130.        BUTTON,AT(70,60,10,10),USE(?but65)
  131.        BUTTON,AT(80,60,10,10),USE(?but66)
  132.        BUTTON,AT(90,60,10,10),USE(?but67)
  133.        BUTTON,AT(100,60,10,10),USE(?but68)
  134.        BUTTON,AT(110,60,10,10),USE(?but69)
  135.        BUTTON,AT(120,60,10,10),USE(?but6a)
  136.        BUTTON,AT(130,60,10,10),USE(?but6b)
  137.        BUTTON,AT(140,60,10,10),USE(?but6c)
  138.        BUTTON,AT(30,70,10,10),USE(?but111)
  139.        BUTTON,AT(40,70,10,10),USE(?but121)
  140.        BUTTON,AT(50,70,10,10),USE(?but131)
  141.        BUTTON,AT(60,70,10,10),USE(?but141)
  142.        BUTTON,AT(70,70,10,10),USE(?but151)
  143.        BUTTON,AT(80,70,10,10),USE(?but161)
  144.        BUTTON,AT(90,70,10,10),USE(?but171)
  145.        BUTTON,AT(100,70,10,10),USE(?but181)
  146.        BUTTON,AT(110,70,10,10),USE(?but191)
  147.        BUTTON,AT(120,70,10,10),USE(?but1a1)
  148.        BUTTON,AT(130,70,10,10),USE(?but1b1)
  149.        BUTTON,AT(140,70,10,10),USE(?but1c1)
  150.        BUTTON,AT(30,80,10,10),USE(?but211)
  151.        BUTTON,AT(40,80,10,10),USE(?but221)
  152.        BUTTON,AT(50,80,10,10),USE(?but231)
  153.        BUTTON,AT(60,80,10,10),USE(?but241)
  154.        BUTTON,AT(70,80,10,10),USE(?but251)
  155.        BUTTON,AT(80,80,10,10),USE(?but261)
  156.        BUTTON,AT(90,80,10,10),USE(?but271)
  157.        BUTTON,AT(100,80,10,10),USE(?but281)
  158.        BUTTON,AT(110,80,10,10),USE(?but291)
  159.        BUTTON,AT(120,80,10,10),USE(?but2a1)
  160.        BUTTON,AT(130,80,10,10),USE(?but2b1)
  161.        BUTTON,AT(140,80,10,10),USE(?but2c1)
  162.        BUTTON,AT(30,90,10,10),USE(?but311)
  163.        BUTTON,AT(40,90,10,10),USE(?but321)
  164.        BUTTON,AT(50,90,10,10),USE(?but331)
  165.        BUTTON,AT(60,90,10,10),USE(?but341)
  166.        BUTTON,AT(70,90,10,10),USE(?but351)
  167.        BUTTON,AT(80,90,10,10),USE(?but361)
  168.        BUTTON,AT(90,90,10,10),USE(?but371)
  169.        BUTTON,AT(100,90,10,10),USE(?but381)
  170.        BUTTON,AT(110,90,10,10),USE(?but391)
  171.        BUTTON,AT(120,90,10,10),USE(?but3a1)
  172.        BUTTON,AT(130,90,10,10),USE(?but3b1)
  173.        BUTTON,AT(140,90,10,10),USE(?but3c1)
  174.        BUTTON,AT(30,100,10,10),USE(?but411)
  175.        BUTTON,AT(40,100,10,10),USE(?but421)
  176.        BUTTON,AT(50,100,10,10),USE(?but431)
  177.        BUTTON,AT(60,100,10,10),USE(?but441)
  178.        BUTTON,AT(70,100,10,10),USE(?but451)
  179.        BUTTON,AT(80,100,10,10),USE(?but461)
  180.        BUTTON,AT(90,100,10,10),USE(?but471)
  181.        BUTTON,AT(100,100,10,10),USE(?but481)
  182.        BUTTON,AT(110,100,10,10),USE(?but491)
  183.        BUTTON,AT(120,100,10,10),USE(?but4a1)
  184.        BUTTON,AT(130,100,10,10),USE(?but4b1)
  185.        BUTTON,AT(140,100,10,10),USE(?but4c1)
  186.        BUTTON,AT(30,110,10,10),USE(?but511)
  187.        BUTTON,AT(40,110,10,10),USE(?but521)
  188.        BUTTON,AT(50,110,10,10),USE(?but531)
  189.        BUTTON,AT(60,110,10,10),USE(?but541)
  190.        BUTTON,AT(70,110,10,10),USE(?but551)
  191.        BUTTON,AT(80,110,10,10),USE(?but561)
  192.        BUTTON,AT(90,110,10,10),USE(?but571)
  193.        BUTTON,AT(100,110,10,10),USE(?but581)
  194.        BUTTON,AT(110,110,10,10),USE(?but591)
  195.        BUTTON,AT(120,110,10,10),USE(?but5a1)
  196.        BUTTON,AT(130,110,10,10),USE(?but5b1)
  197.        BUTTON,AT(140,110,10,10),USE(?but5c1)
  198.        BUTTON,AT(30,120,10,10),USE(?but611)
  199.        BUTTON,AT(40,120,10,10),USE(?but621)
  200.        BUTTON,AT(50,120,10,10),USE(?but631)
  201.        BUTTON,AT(60,120,10,10),USE(?but641)
  202.        BUTTON,AT(70,120,10,10),USE(?but651)
  203.        BUTTON,AT(80,120,10,10),USE(?but661)
  204.        BUTTON,AT(90,120,10,10),USE(?but671)
  205.        BUTTON,AT(100,120,10,10),USE(?but681)
  206.        BUTTON,AT(110,120,10,10),USE(?but691)
  207.        BUTTON,AT(120,120,10,10),USE(?but6a1)
  208.        BUTTON,AT(130,120,10,10),USE(?but6b1)
  209.        BUTTON,AT(140,120,10,10),USE(?but6c1)
  210.        STRING(@N5),AT(30,140,20,10),FONT('Helv',10,0FFH,),USE(counts[1],1001)
  211.        STRING(@N5),AT(110,140,20,10),FONT('Helv',10,0FF00H,),USE(counts[2],1002)
  212.        STRING(@N5),AT(70,140,20,10),FONT('Helv',10,0FF0000H,),USE(counts[3],1003)
  213.        STRING(@N5),AT(150,140,20,10),FONT('Helv',10,0FFFFH,),USE(counts[4],1004)
  214.        STRING(@N5),AT(30,140,20,10),FONT('Helv',10,0FFH,),USE(scores[1],2001)
  215.        STRING(@N5),AT(110,140,20,10),FONT('Helv',10,0FF00H,),USE(scores[2],2002)
  216.        STRING(@N5),AT(70,140,20,10),FONT('Helv',10,0FF0000H,),USE(scores[3],2003)
  217.        STRING(@N5),AT(150,140,20,10),FONT('Helv',10,0FFFFH,),USE(scores[4],2004)
  218.        BOX,AT(29,139,22,12),USE(?box1,3001)
  219.        BOX,AT(109,139,22,12),USE(?box2,3002)
  220.        BOX,AT(69,139,22,12),USE(?box3,3003)
  221.        BOX,AT(149,139,22,12),USE(?box4,3004)
  222.      END
  223.  
  224.   CODE
  225.   HELP('DOMIN')
  226.   width = 6;
  227.   boardwidth = '6x6'
  228.   wp[1] = SHuman
  229.   playname[1] = 'Human'
  230.   wp[2] = SDefence
  231.   playname[2] = 'Defensive'
  232.   wp[3] = 0
  233.   playname[3] = 'None'
  234.   wp[4] = 0
  235.   playname[4] = 'None'
  236.   OPEN(scr)
  237.   setsize()
  238.   init()
  239.   setcursors()
  240.   ACCEPT
  241.     CASE EVENT()
  242.     OF EVENT:CloseWindow
  243.     OROF EVENT:CloseDown
  244.       IF asknewgame()
  245.         BREAK
  246.       ELSE
  247.         CYCLE
  248.       END
  249.     OF EVENT:Accepted
  250.       CASE ACCEPTED()
  251.       OF ?exit
  252.         IF asknewgame()
  253.           BREAK
  254.         END
  255.       OF ?new
  256.         IF asknewgame()
  257.           init();
  258.         END
  259.       OF ?options
  260.         IF asknewgame()
  261.           getoptions()
  262.           init();
  263.         END
  264.       OF ?helpcontents
  265.          HELP()
  266.       OF ?about
  267.          aboutbox()
  268.       ELSE
  269.         yp = ((ACCEPTED()-1) / maxwidth)+1
  270.         xp = ((ACCEPTED()-1) % maxwidth)+1
  271.         IF nplaying>1 AND canadd(xp,yp,nextgo) THEN
  272.           gameinprogress = 1
  273.           counts[nextgo] = counts[nextgo] + 1
  274.           DISPLAY(1000+nextgo)
  275.           addc(xp,yp,nextgo)
  276.           LOOP
  277.             HIDE(3000+nextgo,3000+nextgo)
  278.             nextgo = nextgo + 1
  279.             IF nextgo > mplayers THEN nextgo = 1.
  280.             IF counts[nextgo] THEN
  281.               UNHIDE(3000+nextgo,3000+nextgo)
  282.               IF wp[nextgo] = SHuman THEN
  283.                 setcursors()
  284.                 BREAK
  285.               END
  286.               positional(xp,yp,nextgo)
  287.               IF canadd(xp,yp,nextgo) THEN
  288.                 DISPLAY(1000+nextgo)
  289.                 counts[nextgo] = counts[nextgo] + 1
  290.                 addc(xp,yp,nextgo)
  291.               END
  292.               IF gameinprogress = 0 THEN BREAK.
  293.             END
  294.           END
  295.         ELSE
  296.           BEEP
  297.  
  298.         END
  299.       END
  300.     END
  301.   END
  302.   CLOSE(scr)
  303.  
  304. showp PROCEDURE(x,y)
  305. st  STRING(20),AUTO
  306. count BYTE
  307.   CODE
  308.     IF t[x,y] THEN
  309.       st = '~plxn.ico'
  310.       st[4] = bshift(t[x,y],-3) - 1
  311.       count = t[x,y] % 8
  312.       IF count>3 THEN
  313.         st[5] = 4
  314.       ELSE
  315.         st[5] = count
  316.       END
  317.     ELSE
  318.       st = '~empty.ico'
  319.     END
  320.     ((y-1)*maxwidth + x){PROP:Icon} = st
  321.  
  322.  
  323. getoptions PROCEDURE
  324. optscreen window('Domination'), at(,,150,150), DOUBLE,GRAY,CENTER,HLP('~Options')
  325.     string('Select player types:'),AT(10,20,150,10)
  326.     prompt('Player &1:'), at(10,40,50,10),FONT('Helv',10,00000FFH)
  327.     LIST, FROM('None|Human|Defensive|Homicidal|Regicidal|Drifter'), |
  328.           DROP(6), USE(playname[1],1),AT(60,40,50,10),FONT('Helv',10,00000FFH)
  329.     prompt('Player &2:'), at(10,55,50,10),FONT('Helv',10,000FF00H)
  330.     LIST, FROM('None|Human|Defensive|Homicidal|Regicidal|Drifter'), |
  331.           DROP(6), USE(playname[2],2),AT(60,55,50,10),FONT('Helv',10,000FF00H)
  332.     prompt('Player &3:'), at(10,70,50,10),FONT('Helv',10,0FF0000H)
  333.     LIST, FROM('None|Human|Defensive|Homicidal|Regicidal|Drifter'), |
  334.           DROP(6), USE(playname[3],3),AT(60,70,50,10),FONT('Helv',10,0FF0000H)
  335.     prompt('Player &4:'), at(10,85,50,10),FONT('Helv',10,000FFFFH)
  336.     LIST, FROM('None|Human|Defensive|Homicidal|Regicidal|Drifter'), |
  337.           DROP(6), USE(playname[4],4),AT(60,85,50,10),FONT('Helv',10,000FFFFH)
  338.     prompt('&Board width'), at(10,100,50,10)
  339.     LIST, FROM('6x6|8x8|10x10|12x12'), DROP(4), USE(boardwidth),AT(60,100,50,10)
  340.     button('&Ok'),AT(80,115,50,12),USE(?optok),DEFAULT
  341.   END
  342. changewidth SHORT
  343. x SHORT, AUTO
  344. y SHORT, AUTO
  345. w SHORT, AUTO
  346. h SHORT, AUTO
  347.   CODE
  348.   open(optscreen)
  349.   ACCEPT
  350.     IF EVENT() = EVENT:Accepted
  351.       CASE ACCEPTED()
  352.       OF 1
  353.       OROF 2
  354.       OROF 3
  355.       OROF 4
  356.         wp[ACCEPTED()] = CHOICE()-1
  357.       OF ?boardwidth
  358.         CASE CHOICE()
  359.         OF 1
  360.           width = 6
  361.         OF 2
  362.           width = 8
  363.         OF 3
  364.           width = 10
  365.         OF 4
  366.           width = 12
  367.         END
  368.         changewidth = 1
  369.       OF ?optok
  370.         BREAK
  371.     END END
  372.   END
  373.   CLOSE(optscreen)
  374.   IF changewidth THEN
  375.     setsize()
  376.   END
  377.  
  378. setsize PROCEDURE
  379. space SHORT
  380. ypos  SHORT
  381.   CODE
  382.   space = width*10 / 3
  383.   ypos = 40+width*10
  384.   SetPosition(1001, 20, ypos, 18, 10)
  385.   SetPosition(1003, 20+space, ypos, 18, 10)
  386.   SetPosition(1002, 20+space*3, ypos, 18, 10)
  387.   SetPosition(1004, 20+space*2, ypos, 18, 10)
  388.   ypos = ypos+12
  389.   SetPosition(2001, 20, ypos, 18, 10)
  390.   SetPosition(2003, 20+space, ypos, 18, 10)
  391.   SetPosition(2002, 20+space*3, ypos, 18, 10)
  392.   SetPosition(2004, 20+space*2, ypos, 18, 10)
  393.   ypos = ypos-13
  394.   SetPosition(3001, 19, ypos, 20, 24)
  395.   SetPosition(3003, 19+space, ypos, 20, 24)
  396.   SetPosition(3002, 19+space*3, ypos, 20, 24)
  397.   SetPosition(3004, 19+space*2, ypos, 20, 24)
  398.   LOOP i# = 1 TO maxwidth
  399.     LOOP j# = 1 TO maxwidth
  400.       feq# = (j#-1)*maxwidth + i#
  401.       IF i#>width OR j#>width THEN
  402.         HIDE(feq#, feq#)
  403.       ELSE
  404.         t[i#,j#] = 0
  405.         showp(i#,j#)
  406.         UNHIDE(feq#, feq#)
  407.       END
  408.     END
  409.   END
  410.   SetPosition(0,,,60+width*10, 80+width*10)
  411.  
  412. asknewgame FUNCTION
  413. askscreen WINDOW('Domination'),AT(,,90,50),DOUBLE,GRAY,CENTER
  414.     STRING('Abort current game?'),AT(0,10,90,10),CENTER
  415.     BUTTON('&No'),AT(10,30,30,12),USE(?cancel,1)
  416.     BUTTON('&Yes'),AT(50,30,30,12),USE(?ok,2),DEFAULT
  417.   END
  418.   CODE
  419.   IF gameinprogress=0 THEN RETURN 1.
  420.   OPEN(askscreen)
  421.   ret# = 0
  422.   ACCEPT
  423.     IF EVENT()=EVENT:accepted
  424.       ret# = ACCEPTED()-1
  425.       BREAK
  426.     END
  427.   END
  428.   CLOSE(askscreen)
  429.   RETURN ret#
  430.  
  431. aboutbox PROCEDURE
  432. aboutscreen  WINDOW('About Domination'),AT(,,100,50),CENTER,GRAY,DOUBLE
  433.                STRING('Domination version 1END0'),AT(0,10,100,10),CENTER
  434.                BUTTON('&Ok'),AT(36,28,30,12),USE(?ok),DEFAULT
  435.              END
  436.  
  437.   CODE
  438.   open(aboutscreen)
  439.   ACCEPT
  440.     IF Event()=EVENT:accepted
  441.       BREAK
  442.     END
  443.   END
  444.  
  445. gameover PROCEDURE
  446. overscreen window('Domination'), at(,,90,50),DOUBLE, GRAY, CENTER
  447.     string('Game over!'),AT(0,10,90,10),CENTER
  448.     button('&Ok'),AT(30,30,30,12),USE(?overok)
  449.   END
  450. x SHORT, AUTO
  451. y SHORT, AUTO
  452. w SHORT, AUTO
  453. h SHORT, AUTO
  454.   CODE
  455.   gameinprogress = 0
  456.   open(overscreen)
  457.   ret# = 0
  458.   ACCEPT
  459.     IF EVENT()=EVENT:accepted
  460.       BREAK
  461.     END
  462.   END
  463.   CLOSE(overscreen)
  464.  
  465. setcursors PROCEDURE
  466.   CODE
  467.   RETURN
  468.     LOOP i# = 1 TO width
  469.       LOOP j# = 1 TO width
  470.         feq# = (j#-1)*maxwidth + i#
  471.         IF canadd(i#,j#,nextgo)
  472.           feq#{PROP:Cursor} = '~allowENDcur'
  473.         ELSE
  474.           feq#{PROP:Cursor} = '~disallowENDcur'
  475.         END
  476.       END
  477.     END
  478.  
  479. init PROCEDURE
  480.   CODE
  481.     gameinprogress = 0
  482.     nextgo = 1
  483.     LOOP i# = 1 TO width
  484.       LOOP j# = 1 TO width
  485.         t[i#,j#] = 0
  486.       END
  487.     END
  488.     LOOP i#=1 to mplayers
  489.       scores[i#] = 0
  490.       counts[i#] = 0
  491.     END
  492.     HIDE(1001,1000+mplayers);
  493.     HIDE(2001,2000+mplayers);
  494.     HIDE(3002,3000+mplayers);
  495.     UNHIDE(3001,3001);
  496.     nplaying = 0
  497.     IF wp[1] THEN
  498.       t[1,1] = 9
  499.       counts[1]=1
  500.       nplaying = nplaying + 1
  501.       UNHIDE(1001,1001)
  502.       UNHIDE(2001,2001)
  503.     END
  504.     IF wp[2] THEN
  505.       t[width,width] = 17
  506.       counts[2]=1
  507.       nplaying = nplaying + 1
  508.       UNHIDE(1002,1002)
  509.       UNHIDE(2002,2002)
  510.     END
  511.     IF wp[3] THEN
  512.       t[1,width] = 25
  513.       counts[3]=1
  514.       nplaying = nplaying + 1
  515.       UNHIDE(1003,1003)
  516.       UNHIDE(2003,2003)
  517.     END
  518.     IF wp[4] THEN
  519.       t[width,1] = 33
  520.       counts[4]=1
  521.       nplaying = nplaying + 1
  522.       UNHIDE(1004,1004)
  523.       UNHIDE(2004,2004)
  524.     END
  525.     LOOP i# = 1 TO width
  526.       LOOP j# = 1 TO width
  527.         showp(i#,j#)
  528.       END
  529.     END
  530.  
  531. addc  PROCEDURE(x,y,player)
  532.   CODE
  533.     IF x < 1 OR x > width OR y < 1 OR y > width THEN RETURN.
  534.     IF nplaying < 2 THEN
  535.       RETURN
  536.     END
  537.     scores[player] += 1
  538.     IF (scores[player]%10) = 0 THEN
  539.       DISPLAY(2000+player)
  540.     END
  541.     count# = t[x,y] % 8
  542.     oldp# = bshift(t[x,y],-3)
  543.     IF oldp# and oldp# <> player THEN
  544.       counts[player] = counts[player]+count#
  545.       counts[oldp#] = counts[oldp#]-count#
  546.       IF counts[oldp#] = 0 THEN
  547.         nplaying = nplaying - 1
  548.       END
  549.       DISPLAY(1000+oldp#)
  550.       DISPLAY(1000+player)
  551.     END
  552.     count# = count# + 1
  553.     t[x,y] = player*8 + count#
  554.     showp(x,y)
  555.     IF nplaying < 2  THEN
  556.       gameover()
  557.       RETURN
  558.     END
  559.     cap#=capacity(x,y)
  560.     IF count# >= cap# THEN
  561.       t[x,y] = t[x,y]-cap#
  562.       IF count#=cap# THEN t[x,y]=0.
  563.       showp(x,y)
  564.       addc(x-1,y,player)
  565.       addc(x,y-1,player)
  566.       addc(x,y+1,player)
  567.       addc(x+1,y,player)
  568.     END
  569.  
  570. canadd FUNCTION(x,y,player)
  571.   CODE
  572.     IF x < 1 OR x > width OR y < 1 OR y > width THEN
  573.       RETURN 0 ! Out OF bounds
  574.     END
  575.     IF t[x,y] THEN
  576.       IF bshift(t[x,y],-3) <> player   THEN
  577.         RETURN 0 ! Occupied by the enemy
  578.       ELSE
  579.         RETURN 1
  580.       END
  581.     END
  582.     IF x > 1 and bshift(t[x-1,y],-3) = player THEN
  583.       RETURN 1
  584.     END
  585.     IF y > 1 and bshift(t[x,y-1],-3) = player THEN
  586.       RETURN 1
  587.     END
  588.     IF x < width and bshift(t[x+1,y],-3) = player THEN
  589.       RETURN 1
  590.     END
  591.     IF y < width and bshift(t[x,y+1],-3) = player THEN
  592.       RETURN 1
  593.     END
  594.     RETURN 0
  595.  
  596. capacity  FUNCTION(x,y)
  597. c BYTE
  598.   CODE
  599.     IF x > 1 THEN
  600.       c += 1
  601.     END
  602.     IF x < width THEN
  603.       c += 1
  604.     END
  605.     IF y > 1 THEN
  606.       c += 1
  607.     END
  608.     IF y < width THEN
  609.       c += 1
  610.     END
  611.     RETURN c
  612.  
  613.  
  614. omit('═╝')
  615. ╔═══════════════════════════════════════════════════════════════════════════╗
  616. ║                                                                           ║
  617. ║  This routine computes the 'currently occupied quarter' for each player.  ║
  618. ║  Then depending on the active player strategy it selects which corner     ║
  619. ║  the search should be aiming towards. The actual search mechanism is      ║
  620. ║  performed elsewhere                                                      ║
  621. ║  Result numbering :   1 2                                                 ║
  622. ║                       3 4                                                 ║
  623. ║                                                                           ║
  624. ║  Defensive Strategy : Blow up something as near to your own corner        ║
  625. ║                       as possibleEND Otherwise stockpile                    ║
  626. ║                                                                           ║
  627. ║  Drifter Strategy   : Blow up something as far from your own corner       ║
  628. ║                       as possible                                         ║
  629. ║                                                                           ║
  630. ║  Homicidal Strategy : Go for any available human                          ║
  631. ║                                                                           ║
  632. ║  Regicidal Strategy : Go for any available computer                       ║
  633. ║                                                                           ║
  634. ╚═══════════════════════════════════════════════════════════════════════════╝
  635. locate_target  FUNCTION(player)
  636. ccounts BYTE,DIM(4),DIM(mplayers)
  637. cp  BYTE
  638. res BYTE
  639.   CODE
  640.     LOOP i# = 1 TO width
  641.       IF i# < 7 THEN cp = 1 ELSE cp = 2.
  642.       LOOP j# = 1 TO width
  643.         IF j# = 7 THEN cp += 2.
  644.         IF t[i#,j#] THEN ccounts[cp,bshift(t[i#,j#],-3)] += 1.
  645.     . .
  646.     IF wp[player] = SHomicidal THEN
  647.       cp = 0
  648.       LOOP i# = 1 TO mplayers
  649.         IF wp[i#] = SHuman THEN
  650.           LOOP j# = 1 TO 4
  651.             IF ccounts[j#,i#] > cp THEN
  652.               cp = ccounts[j#,i#]
  653.               res = j#
  654.             END
  655.           END
  656.         END
  657.       END
  658.       IF res = 0 THEN wp[player] = SRegicidal.
  659.     END
  660.     IF wp[player] = SRegicidal THEN
  661.       cp = 0
  662.       LOOP i# = 1 TO mplayers
  663.         IF wp[i#] > SHuman AND i# <> player THEN
  664.           LOOP j# = 1 to 4
  665.             IF ccounts[j#,i#] > cp THEN
  666.               cp = ccounts[j#,i#]
  667.               res = j#
  668.             END
  669.           END
  670.         END
  671.       END
  672.       IF res = 0 THEN wp[player] = SDrifter END
  673.     END
  674.     IF res = 0 THEN
  675.       cp = 0
  676.       LOOP j# = 1 TO 4
  677.         IF ccounts[j#,player] > cp THEN
  678.           cp = ccounts[j#,player]
  679.           res = j#
  680.         END
  681.       END
  682.       IF wp[player] = SDrifter THEN res = 5 - res.
  683.     END
  684.     RETURN res
  685.  
  686. positional   PROCEDURE(x,y,player)
  687. xbv BYTE(255)
  688. near BYTE(255)
  689. xs  SHORT(1)
  690. ys  SHORT(1)
  691. ta  BYTE
  692.   CODE
  693.     x = 0
  694.     y = 0
  695.     ta = locate_target(player)
  696.     CASE ta
  697.     OF 2
  698.       xs = -1
  699.     OF 3
  700.       ys = -1
  701.     OF 4
  702.       xs = -1
  703.       ys = -1
  704.     END
  705.     LOOP i#= 1 to width
  706.       LOOP j#= 1 to width
  707.         IF canadd(i#,j#,player) THEN
  708.           cij# = capacity(i#,j#)
  709.           !cb# = ( cij# - t[i#,j#] % 8 ) * 4 + cij#
  710.           cb# = cij# - t[i#,j#] % 8
  711.           IF xs > 0 THEN di# = i# ELSE di# = 13 - i# END
  712.           di# *= 10
  713.           IF ys > 0 THEN di# += j# ELSE di# += 13 - j#.
  714.           IF cb# < xbv OR cb#= xbv AND di# < near THEN
  715.             xbv = cb#
  716.             near = di#
  717.             x = i#
  718.             y = j#
  719.           END
  720.         END
  721.     END
  722.   END
  723.  
  724.